home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / dump_s1r / selfnt.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1998-12-15  |  11.3 KB  |  372 lines
  1. VERSION 5.00
  2. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.1#0"; "COMDLG32.OCX"
  3. Begin VB.Form frmSelFnt 
  4.    AutoRedraw      =   -1  'True
  5.    BorderStyle     =   3  'Fixed Dialog
  6.    Caption         =   "Select Font"
  7.    ClientHeight    =   4512
  8.    ClientLeft      =   48
  9.    ClientTop       =   336
  10.    ClientWidth     =   4428
  11.    LinkTopic       =   "Form1"
  12.    LockControls    =   -1  'True
  13.    MaxButton       =   0   'False
  14.    MinButton       =   0   'False
  15.    ScaleHeight     =   4512
  16.    ScaleWidth      =   4428
  17.    ShowInTaskbar   =   0   'False
  18.    StartUpPosition =   2  'CenterScreen
  19.    Begin MSComDlg.CommonDialog c 
  20.       Left            =   30
  21.       Top             =   3000
  22.       _ExtentX        =   847
  23.       _ExtentY        =   847
  24.       _Version        =   327681
  25.       CancelError     =   -1  'True
  26.    End
  27.    Begin VB.ComboBox cboColor 
  28.       BeginProperty Font 
  29.          Name            =   "MS Sans Serif"
  30.          Size            =   7.8
  31.          Charset         =   0
  32.          Weight          =   700
  33.          Underline       =   0   'False
  34.          Italic          =   0   'False
  35.          Strikethrough   =   0   'False
  36.       EndProperty
  37.       ForeColor       =   &H00000000&
  38.       Height          =   315
  39.       ItemData        =   "SelFnt.frx":0000
  40.       Left            =   2280
  41.       List            =   "SelFnt.frx":002E
  42.       Style           =   2  'Dropdown List
  43.       TabIndex        =   12
  44.       Top             =   3360
  45.       Width           =   1455
  46.    End
  47.    Begin VB.ListBox lstSize 
  48.       Height          =   2400
  49.       IntegralHeight  =   0   'False
  50.       ItemData        =   "SelFnt.frx":00B5
  51.       Left            =   3120
  52.       List            =   "SelFnt.frx":00E3
  53.       TabIndex        =   10
  54.       Top             =   600
  55.       Width           =   1155
  56.    End
  57.    Begin VB.TextBox txtFontSize 
  58.       Height          =   285
  59.       Left            =   3120
  60.       Locked          =   -1  'True
  61.       TabIndex        =   9
  62.       Text            =   "8"
  63.       Top             =   270
  64.       Width           =   1155
  65.    End
  66.    Begin VB.ListBox lstStyle 
  67.       Height          =   2400
  68.       IntegralHeight  =   0   'False
  69.       ItemData        =   "SelFnt.frx":011D
  70.       Left            =   1920
  71.       List            =   "SelFnt.frx":012D
  72.       MultiSelect     =   2  'Extended
  73.       TabIndex        =   8
  74.       Top             =   600
  75.       Width           =   1155
  76.    End
  77.    Begin VB.TextBox txtPrev 
  78.       Appearance      =   0  'Flat
  79.       Height          =   315
  80.       Left            =   720
  81.       TabIndex        =   5
  82.       Text            =   "Aa Bb Cc"
  83.       Top             =   3360
  84.       Width           =   1455
  85.    End
  86.    Begin VB.PictureBox pPrev 
  87.       Appearance      =   0  'Flat
  88.       AutoRedraw      =   -1  'True
  89.       BackColor       =   &H00808080&
  90.       ForeColor       =   &H80000008&
  91.       Height          =   615
  92.       Left            =   720
  93.       ScaleHeight     =   588
  94.       ScaleWidth      =   2508
  95.       TabIndex        =   3
  96.       Top             =   3870
  97.       Width           =   2535
  98.    End
  99.    Begin VB.ListBox lstFonts 
  100.       Height          =   2400
  101.       IntegralHeight  =   0   'False
  102.       Left            =   60
  103.       TabIndex        =   2
  104.       Top             =   600
  105.       Width           =   1815
  106.    End
  107.    Begin VB.TextBox txtFontName 
  108.       Height          =   285
  109.       Left            =   60
  110.       TabIndex        =   1
  111.       Text            =   "MS Sans Serif"
  112.       Top             =   270
  113.       Width           =   1815
  114.    End
  115.    Begin VB.TextBox txtStyle 
  116.       Height          =   285
  117.       Left            =   1920
  118.       Locked          =   -1  'True
  119.       TabIndex        =   7
  120.       Text            =   "Regular"
  121.       Top             =   270
  122.       Width           =   1155
  123.    End
  124.    Begin VB.Label Label4 
  125.       AutoSize        =   -1  'True
  126.       Caption         =   "Color:"
  127.       Height          =   195
  128.       Left            =   2310
  129.       TabIndex        =   11
  130.       Top             =   3120
  131.       Width           =   405
  132.    End
  133.    Begin VB.Label Label3 
  134.       AutoSize        =   -1  'True
  135.       Caption         =   "Preview Text:"
  136.       Height          =   195
  137.       Left            =   750
  138.       TabIndex        =   6
  139.       Top             =   3120
  140.       Width           =   975
  141.    End
  142.    Begin VB.Label Label2 
  143.       AutoSize        =   -1  'True
  144.       Caption         =   "Preview:"
  145.       Height          =   195
  146.       Left            =   750
  147.       TabIndex        =   4
  148.       Top             =   3660
  149.       Width           =   615
  150.    End
  151.    Begin VB.Label Label1 
  152.       AutoSize        =   -1  'True
  153.       Caption         =   "Font &Name:"
  154.       Height          =   195
  155.       Left            =   60
  156.       TabIndex        =   0
  157.       Top             =   60
  158.       Width           =   825
  159.    End
  160. Attribute VB_Name = "frmSelFnt"
  161. Attribute VB_GlobalNameSpace = False
  162. Attribute VB_Creatable = False
  163. Attribute VB_PredeclaredId = True
  164. Attribute VB_Exposed = False
  165. Option Explicit
  166. Public oFont As StdFont
  167. Public xFont As StdFont
  168. Public Color As Long
  169. Private ActivatedBefore As Boolean
  170. Private WithEvents cmdOK As ComboPack.Button
  171. Attribute cmdOK.VB_VarHelpID = -1
  172. Private WithEvents cmdCancel As ComboPack.Button
  173. Attribute cmdCancel.VB_VarHelpID = -1
  174. Private Sub cboColor_Click()
  175.     If cboColor.ListIndex = -1 Then Exit Sub
  176.     Select Case LCase(cboColor.List(cboColor.ListIndex))
  177.         Case "yellow"
  178.             pPrev.ForeColor = RGB(255, 255, 0)
  179.         Case "blue"
  180.             pPrev.ForeColor = RGB(0, 0, 255)
  181.         Case "custom..."
  182.             Load frmColorSelector
  183.             frmColorSelector.Color = pPrev.ForeColor
  184.             frmColorSelector.SetColor frmColorSelector.Color
  185.             DoUntilNotVisible frmColorSelector
  186.             pPrev.ForeColor = frmColorSelector.Color
  187.             Unload frmColorSelector
  188.         Case "red"
  189.             pPrev.ForeColor = RGB(255, 0, 0)
  190.         Case "green"
  191.             pPrev.ForeColor = RGB(0, 255, 0)
  192.         Case "white"
  193.             pPrev.ForeColor = RGB(255, 255, 255)
  194.         Case "dark blue"
  195.             pPrev.ForeColor = RGB(0, 0, 128)
  196.         Case "dark grey"
  197.             pPrev.ForeColor = RGB(72, 72, 72)
  198.         Case "dark green"
  199.             pPrev.ForeColor = RGB(0, 128, 0)
  200.         Case "dark yellow"
  201.             pPrev.ForeColor = RGB(128, 128, 0)
  202.         Case "dark red"
  203.             pPrev.ForeColor = RGB(128, 0, 0)
  204.         Case "black"
  205.             pPrev.ForeColor = RGB(0, 0, 0)
  206.         Case "grey"
  207.             pPrev.ForeColor = RGB(128, 128, 128)
  208.         Case "system color..."
  209.             'TO DO
  210.     End Select
  211.     cboColor.ForeColor = pPrev.ForeColor
  212. End Sub
  213. Private Sub cmdCancel_Click()
  214.     Unload Me
  215. End Sub
  216. Private Sub cmdCancel_Press()
  217.     cmdCancel.HasFocus = True
  218.     cmdOK.HasFocus = False
  219. End Sub
  220. Private Sub cmdOK_Click()
  221.     Set oFont = New StdFont
  222.     With oFont
  223.     .Size = pPrev.Font.Size
  224.     .Bold = pPrev.Font.Bold
  225.     .Italic = pPrev.Font.Italic
  226.     .Underline = pPrev.Font.Underline
  227.     .Name = pPrev.Font.Name
  228.     End With
  229.     Unload Me
  230.     Hide
  231. End Sub
  232. Private Sub cmdOK_Press()
  233.     cmdCancel.HasFocus = False
  234.     cmdOK.HasFocus = True
  235. End Sub
  236. Private Sub Form_Load()
  237.     Set cmdOK = New ComboPack.Button
  238.     Set cmdOK.Parent = frmSelFnt
  239.     cmdOK.Left = 3310
  240.     cmdOK.Top = 3860
  241.     cmdOK.Height = 300
  242.     cmdOK.Width = 1065
  243.     cmdOK.ForeColor = 0
  244.     cmdOK.Name = "cmdOK"
  245.     cmdOK.Enabled = True
  246.     cmdOK.Caption = "OK"
  247.     cmdOK.BackColor = -2147483633
  248.     cmdOK.Redraw
  249.     Set cmdCancel = New ComboPack.Button
  250.     Set cmdCancel.Parent = frmSelFnt
  251.     cmdCancel.Left = 3310
  252.     cmdCancel.Top = 4180
  253.     cmdCancel.Height = 300
  254.     cmdCancel.Width = 1065
  255.     cmdCancel.ForeColor = 0
  256.     cmdCancel.BackColor = -2147483633
  257.     cmdCancel.Name = "cmdCancel"
  258.     cmdCancel.Enabled = True
  259.     cmdCancel.Caption = "Cancel"
  260.     cmdCancel.Redraw
  261. End Sub
  262. Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  263. cmdOK.MouseDown Button, X, Y
  264. cmdCancel.MouseDown Button, X, Y
  265. End Sub
  266. Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  267. cmdOK.MouseMove Button, X, Y
  268. cmdCancel.MouseMove Button, X, Y
  269. End Sub
  270. Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  271. cmdOK.MouseUp Button, X, Y
  272. cmdCancel.MouseUp Button, X, Y
  273. End Sub
  274. Private Sub Form_Activate()
  275.     If ActivatedBefore Then Exit Sub
  276.     ActivatedBefore = True
  277.     Dim Font As Long
  278.     If xFont Is Nothing Then Unload Me: Exit Sub
  279.     For Font = 0 To Screen.FontCount - 1
  280.         lstFonts.AddItem Screen.Fonts(Font)
  281.     Next
  282.     txtFontName = xFont.Name
  283.     SelectInList lstFonts, txtFontName
  284.     SelectInList lstStyle, txtStyle
  285.     txtFontSize = xFont.Size \ 1 'Just in case the _
  286.     font is something like 8.5, It has happened...
  287.     SelectInList lstSize, txtFontSize
  288.     lstStyle.ListIndex = 0
  289.     lstStyle.Selected(0) = True
  290.     If xFont.Bold Then
  291.         lstStyle.Selected(0) = False
  292.         lstStyle.Selected(1) = True
  293.     End If
  294.     If xFont.Italic Then
  295.         lstStyle.Selected(0) = False
  296.         lstStyle.Selected(2) = True
  297.     End If
  298.     If xFont.Underline Then
  299.         lstStyle.Selected(0) = False
  300.         lstStyle.Selected(3) = True
  301.     End If
  302. End Sub
  303. Public Sub SelectInList(ListBox As ListBox, TextBox As TextBox)
  304. If TextBox = "" Then Exit Sub
  305. Dim m_lngLoop As Long
  306. For m_lngLoop = 0 To ListBox.ListCount - 1
  307. If LCase(ListBox.List(m_lngLoop)) = LCase(TextBox) Then
  308. ListBox.ListIndex = m_lngLoop
  309. End If
  310. PrintPreview
  311. End Sub
  312. Private Sub Form_Unload(Cancel As Integer)
  313.     ActivatedBefore = False
  314. End Sub
  315. Private Sub lstFonts_Click()
  316. txtFontName = lstFonts.List(lstFonts.ListIndex)
  317. End Sub
  318. Private Sub lstSize_Click()
  319. txtFontSize = lstSize.List(lstSize.ListIndex)
  320. SelectInList lstSize, txtFontSize
  321. End Sub
  322. Private Sub lstStyle_Click()
  323.     Dim m_lngLoop As Long
  324.     txtStyle = ""
  325.         For m_lngLoop = 0 To lstStyle.ListCount - 1
  326.             If lstStyle.Selected(m_lngLoop) Then
  327.                 txtStyle = txtStyle & lstStyle.List(m_lngLoop) & " "
  328.             End If
  329.         Next
  330.     If lstStyle.Selected(0) Then
  331.         For m_lngLoop = 1 To lstStyle.ListCount - 1
  332.             lstStyle.Selected(m_lngLoop) = False
  333.         Next
  334.     End If
  335.     If lstStyle.Selected(1) Then
  336.         pPrev.FontBold = True
  337.     Else
  338.         pPrev.FontBold = False
  339.     End If
  340.     If lstStyle.Selected(2) Then
  341.         pPrev.FontItalic = True
  342.     Else
  343.         pPrev.FontItalic = False
  344.     End If
  345.     If lstStyle.Selected(3) Then
  346.         pPrev.FontUnderline = True
  347.     Else
  348.         pPrev.FontUnderline = False
  349.     End If
  350.     PrintPreview
  351. End Sub
  352. Private Sub txtFontName_Change()
  353.     If txtFontName = "" Then Exit Sub
  354.     SelectInList lstFonts, txtFontName
  355. End Sub
  356. Public Sub PrintPreview()
  357.     pPrev.Cls
  358.     pPrev.FontName = lstFonts.List(lstFonts.ListIndex)
  359.     pPrev.FontSize = txtFontSize
  360.     pPrev.CurrentX = pPrev.Width / 2 - pPrev.TextWidth(txtPrev) / 2
  361.     pPrev.CurrentY = pPrev.Height / 2 - pPrev.TextHeight(txtPrev) / 2
  362.     pPrev.Print txtPrev
  363. End Sub
  364. Private Sub txtPrev_Change()
  365.     PrintPreview
  366. End Sub
  367. Private Sub UpdateCombo()
  368.     Select Case Color
  369.         'To Do
  370.     End Select
  371. End Sub
  372.